home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PCMania 56
/
PCMania CD56_1.iso
/
abc.z
/
NETWORK.FRM
< prev
next >
Wrap
Text File
|
1996-12-16
|
16KB
|
564 lines
VERSION 4.00
Begin VB.Form NetworkDatabaseDemo
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Network Database Demo"
ClientHeight = 1950
ClientLeft = 1245
ClientTop = 2190
ClientWidth = 5265
ClipControls = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 2355
Icon = "NETWORK.frx":0000
Left = 1185
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 1950
ScaleWidth = 5265
Top = 1845
Width = 5385
Begin VB.CommandButton BrowseBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Browse..."
Height = 375
Left = 3690
TabIndex = 6
Top = 795
Width = 1335
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 495
Left = 4350
Picture = "NETWORK.frx":030A
ScaleHeight = 495
ScaleWidth = 495
TabIndex = 4
Top = 195
Width = 495
End
Begin VB.Data Data1
Appearance = 0 'Flat
Caption = "Data1"
Connect = ""
DatabaseName = ""
Exclusive = 0 'False
Height = 270
Left = 1440
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Network"
Top = 3600
Visible = 0 'False
Width = 1935
End
Begin VB.CommandButton cmdCancel
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Cancel"
Height = 375
Left = 2640
TabIndex = 2
Top = 1440
Width = 1335
End
Begin VB.CommandButton cmdOK
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&OK"
Default = -1 'True
Height = 375
Left = 1065
TabIndex = 1
Top = 1440
Width = 1335
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 285
Left = 105
TabIndex = 0
Top = 840
Width = 3465
End
Begin MSComDlg.CommonDialog OpenDatabaseFile
Left = 120
Top = 1440
_Version = 65536
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin AbcflowLib.ABC ABC1
Left = 4320
Top = 1440
_Version = 65536
_ExtentX = 1085
_ExtentY = 873
_StockProps = 1
End
Begin VB.Label Label2
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "Press ""Browse"" to choose another database."
ForeColor = &H80000008&
Height = 495
Left = 840
TabIndex = 5
Top = 120
Width = 3015
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Database File:"
ForeColor = &H80000008&
Height = 195
Left = 120
TabIndex = 3
Top = 600
Width = 1245
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
X1 = 0
X2 = 5280
Y1 = 1320
Y2 = 1320
End
End
Attribute VB_Name = "NetworkDatabaseDemo"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim ABC As Object
Dim NetSource As RECORD
Dim UserName As String
Dim DataBaseFile As String
Dim TestFileValid As String
Const DATA_ERRCONTINUE = 1
Const DATA_ERRDISPLAY = 0
Const OFN_FILEMUSTEXIST = &H1000&
Const OFN_PATHMUSTEXIST = &H800&
Private Sub ABC1_AppQuitNOTIFY()
Data1.Recordset.Close
End
End Sub
Private Sub ABC1_DoubleClickSUBCLASS(ByVal Object As Object, ByVal Chart As Object, Override As Boolean)
Dim Obj As Object
Set Obj = ABC1.Chart.Objects.ItemFromText(".mdb")
If Obj.Valid Then
' Get the database from the chart
Data1.DatabaseName = Obj.Text
GetDatabaseInfo (Object.Text)
Else
End If
Override = True
End Sub
Private Sub BrowseBtn_Click()
'In case of error
On Error Resume Next
'Set properties here
OpenDatabaseFile.CancelError = True
OpenDatabaseFile.DefaultExt = "mdb"
OpenDatabaseFile.Filter = "Database Files(*.mdb)|*.mdb"
OpenDatabaseFile.Flags = OFN_FILEMUSTEXIST And OFN_PATHMUSTEXIST
OpenDatabaseFile.Action = 1
'Close if cancelled
If Err = 32755 Then
Exit Sub
Else
DataBaseFile = OpenDatabaseFile.filename
End If
Text1.Text = DataBaseFile
End Sub
Private Sub cmdCancel_Click()
Unload NetworkDatabaseDemo
End
End Sub
Private Sub cmdOK_Click()
Dim DataBaseFileOne As Integer
Dim DataBaseFileTwo As Integer
Err = 0
DataBaseFile = Text1.Text
DataBaseFileOne = InStr(DataBaseFile, "NETBASE1.MDB")
DataBaseFileTwo = InStr(DataBaseFile, "NETBASE2.MDB")
If Not DataBaseFileOne > 1 And DataBaseFileTwo = 0 Then
Err = 2
ElseIf Not DataBaseFileTwo > 1 And DataBaseFileOne = 0 Then
Err = 2
End If
If Err = 1 Then
cmdOK.Enabled = False
MsgBox "File does not exist!", 48
Text1.SetFocus
End If
If Err = 2 Then
cmdOK.Enabled = False
MsgBox "This is an Invalid Database File!", 48
Text1.SetFocus
End If
If Err = 0 Then
cmdOK.Enabled = False
NetworkDatabaseDemo.WindowState = 1 ' iconize form
NetworkDatabaseDemo.Refresh
'Build the chart
Call DrawNetChart(DataBaseFile)
Call ValidateFilename
End If
End Sub
Private Sub DrawNetChart(DataBaseFile As String)
Dim Shape As Object
Dim Shape1 As Object
Dim TextTitle As Object
Dim recCount As Integer
Dim PageWidth As Integer
Dim ChartCancelled As Integer
Dim CurrentRec As String
Dim FieldInfo As String
Dim ProcessorType As String
Dim Chart As Object
Dim ABCObject As Object
Dim NewLine() As Object
Dim Obj As Object
Dim DataBaseText As Object
Dim Counter As Integer
Dim TotalCount As Integer
'Get the chart
Set Chart = ABC.New
Rem Set the Chart's internal type
Chart.Type = "NETWORK"
Chart.TypeUsesEXE = True
Set ABCObject = Chart.Objects
'Prepare for chart to draw
Chart.NoRepaint = True
Chart.MasterItems.HideAll
Chart.PageLayout.Orientation = 1
Chart.View = 1
ABC.ShapePaletteVisible = False
' Set defaults so there are no shape numbers
Set Obj = Chart.DrawShape
Obj.Shape.NumberShowN = False
Chart.SetDefaults Obj
Obj.Clear_ 'This object can be seen when selected'
'Set gauge
ABC.PercentGauge NetworkDatabaseDemo.Caption, "Building Diagram", "Please Wait..."
ChartCancelled = ABC.PercentGaugeCancelled
If ChartCancelled = True Then
Call EndAppDraw
End If
'Title page
Chart.CurrentShapePalette = "Standard"
Chart.CurrentShape = "Rounded Process"
Chart.DrawPositionX = 4.5
Chart.DrawPositionY = 0.5
Set Shape = Chart.DrawShape
Shape.Height = 0.5
Shape.Width = 5.5
Shape.Text = "Network Diagram"
Shape.Font.Size = 18
Shape.Font.Bold = True
Shape.Shape.BorderWidth = 3
Shape.Shape.BorderColor = ABC.RED
Shape.Shape.FillColor = ABC.GRAY
'give feedback here
'ABC.PercentGaugeValue = 10
'cancel chart?
ChartCancelled = ABC.PercentGaugeCancelled
If ChartCancelled Then
Call EndAppDraw
End If
'Get Network palette
Chart.CurrentShapePalette = "Net - PC Workstations"
Chart.CurrentShape = "Tower"
'Set shape spacing
Chart.DrawPositionX = 4.5
Chart.DrawPositionY = 1.5
Set Shape1 = Chart.DrawShape
Shape1.Height = 1.25
Shape1.Width = 1.25
Shape1.Text = "SERVER"
Shape1.Font.Bold = True
Shape1.Font.Size = 12
ChartCancelled = ABC.PercentGaugeCancelled
If ChartCancelled Then
Call EndAppDraw
End If
'Open the Database
Data1.DatabaseName = DataBaseFile
Data1.RecordSource = "Network"
Data1.Refresh
'Get the number of records
recCount = GetRecNum(Data1.Recordset)
Data1.Refresh
PageWidth = Chart.PageLayout.Width
If recCount <= 5 Then
Chart.DrawSpacingX = PageWidth / recCount
Chart.DrawPositionX = (PageWidth / 2) / recCount
Else
Chart.DrawSpacingX = 1.5
Chart.DrawPositionX = 1
End If
Chart.DrawPositionY = 3.5
Chart.DrawDirection = 1
Do While Not Data1.Recordset.EOF
CurrentRec = GetCurrRec(Data1.Recordset)
CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)
FieldInfo = Trim(NetSource.User)
ProcessorType = Trim(NetSource.Computer)
'Draw Shapes and add Usernames
Chart.CurrentShape = ProcessorType
Set Shape = Chart.DrawShape
Shape.Height = 1.25
Shape.Width = 1.25
Shape.Text = FieldInfo
Shape.Font.Size = 12
Shape.Font.Color = ABC.BLUE
TotalCount = recCount
Counter = 100 / TotalCount
'Draw Lines from server to workstation
Chart.CurrentLineRouting = 3
ReDim NewLine(recCount) As Object
Set NewLine(recCount) = Chart.DrawLine(Shape1, Shape, 2, 0)
NewLine(recCount).Line_.StemWidth = 3
recCount = recCount - 1
'Increment gauge
If Counter > 0 Then
ABC.PercentGaugeValue = Int(100 - (Counter * recCount))
End If
Data1.Recordset.MoveNext
Loop
'Give feedback here
'ABC.PercentGaugeValue = 90
ChartCancelled = ABC.PercentGaugeCancelled
If ChartCancelled Then
Call EndAppDraw
End If
'Give double-click instructions
Chart.DrawPositionX = 1.5
Chart.DrawPositionY = 5
Set TextTitle = Chart.DrawTextBlock(UCase("To find server information, Double-click on a shape."))
TextTitle.Font.Bold = True
TextTitle.Font.Size = 16
TextTitle.CenterX = PageWidth / 2
' Write out database name
Chart.DrawPositionX = 1.5
Chart.DrawPositionY = 5.25
Set DataBaseText = Chart.DrawTextBlock(LCase(Text1))
DataBaseText.Font.Bold = False
DataBaseText.Font.Size = 12
DataBaseText.CenterX = PageWidth / 2
'Data1.Recordset.Close
Data1.Refresh
'Give feedback here
ABC.PercentGaugeValue = 99
ABC.HidePercentGauge
'Draw chart
Chart.NoRepaint = False
Chart.Repaint
End Sub
Private Sub EndAppDraw()
ABC.HidePercentGauge
End
End Sub
Private Sub Form_Load()
'Open ABC
Set ABC = CreateObject("ABCFlow.Application")
' ABC.Maximize
ABC.Hourglass = True
ABC.Visible = True
'Register the Events
ABC.RegisterEvent ABC1, "Network", "DoubleClickSUBCLASS"
ABC.RegisterEvent ABC1, "Network", "AppQuitNOTIFY"
'Load both forms
Load ServerInfo
NetworkDatabaseDemo.Left = (Screen.Width - Width) \ 2
NetworkDatabaseDemo.Top = (Screen.Height - Height) \ 2
Text1.Text = UCase(App.Path & "\" & "netbase1.mdb")
NetworkDatabaseDemo.Show
End Sub
Private Sub GetDatabaseInfo(UserName As String)
Dim CurrentRec As String
Data1.RecordSource = "Network"
Data1.Refresh
'Find this username in the database
If UserName = Data1.Recordset.Fields("User").Value Then
CurrentRec = GetCurrRec(Data1.Recordset)
CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)
'Display server information
ServerInfo.txtType.Text = Trim$(NetSource.Type)
ServerInfo.txtProcess = Trim$(NetSource.Computer)
ServerInfo.txtUserID = Trim$(NetSource.UserID)
ServerInfo.txtUserName = Trim$(NetSource.User)
ServerInfo.txtServer = Trim$(NetSource.Server)
ServerInfo.Show 1
ElseIf UserName = "" Then
MsgBox "This Station is Unassigned.", 64
ElseIf Not UserName = Data1.Recordset.Fields("User").Value Then
Data1.Recordset.MoveFirst
Do
Data1.Recordset.MoveNext
On Error GoTo Error_out
Loop Until Data1.Recordset.EOF = True Or UserName = Data1.Recordset.Fields("User").Value
CurrentRec = GetCurrRec(Data1.Recordset)
CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)
'Display server information
ServerInfo.txtType.Text = Trim$(NetSource.Type)
ServerInfo.txtProcess = Trim$(NetSource.Computer)
ServerInfo.txtUserID = Trim$(NetSource.UserID)
ServerInfo.txtUserName = Trim$(NetSource.User)
ServerInfo.txtServer = Trim$(NetSource.Server)
ServerInfo.Show 1
End If
Error_out:
Select Case Err
Case 3021
ServerInfo.Hide
MsgBox UCase("This is not a Workstation!") + Chr(13) + Chr(13) + " Please choose a valid name."
'DATA_ERRDISPLAY = 0
'DATA_ERRCONTINUE = 1
Data1.Refresh
Data1.Recordset.MoveFirst
Resume CloseDB
Case Else
Data1.Refresh
ServerInfo.Hide
End Select
CloseDB:
Data1.Refresh
Data1.Recordset.MoveFirst
End Sub
Private Sub Text1_Change()
Call ValidateFilename
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub ValidateFilename()
Dim Attr As Single
On Error Resume Next
Attr = GetAttr(Text1)
If Err Then
cmdOK.Enabled = False
Else
cmdOK.Enabled = True
End If
End Sub